home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / pgmmenu.arc / CRC1235.RPG < prev    next >
Text File  |  1991-12-04  |  13KB  |  265 lines
  1.       /TITLE  Programmer menu user's defaults maintenance.
  2.       *       Program - CRC1235
  3.       *       Written - 04/12/84
  4.       *       Revised - 09/04/84 - 12/30/85
  5.       *       Author  - R. Cozzi, Jr.
  6.      FCRC1235 CF  E                    WORKSTN      KINFSR *PSSR
  7.      F                                        RRN   KSFILE CRC1235D
  8.      E                    SEQA       25 15               Sequencing Array
  9.      E                    LIBL       25 11               Initial LibL
  10.      ISEQDS       DS
  11.      I                                       01  052SEQ
  12.      I                                       06  15 LIB
  13.      IUSR         DS
  14.      I                                       01  10 USER
  15.      I                                       11  20 LIBR
  16.      I            DS
  17.       *  The subfile's relative record number
  18.       *  field and the "X" variable will always
  19.       *  contain the same value (i.e., X Equates RRN).
  20.      I                                    P  01  030RRN
  21.      I                                    P  01  030X
  22.      IPGMDFT    E DSCRC1239                    2000
  23.      I              SRCFILE                         SRCF
  24.      I              SRCLIB                          SRCFLB
  25.      I              OBJLIB                          OBJLB
  26.      I              JOBD                            JOBD
  27.      I              JOBDLIB                         JOBDLB
  28.      I              LOG                             LOG
  29.      I              SIGNOFF                         SIGNOF
  30.      I              LOGCLPGM                        LOGCLP
  31.      I              ALWRTVSRC                       ALWRTV
  32.      I              USRPRF                          USRPRF
  33.      I              PUBAUT                          PUBAUT
  34.      I              RSTDSP                          RSTDSP
  35.      I              DFRWRT                          DFRWRT
  36.       *  Data base file size.
  37.      I              SIZE1                           SIZE1
  38.      I              SIZE2                           SIZE2
  39.      I              SIZE3                           SIZE3
  40.      I              MAXRCDS                         MAXRCD
  41.      I              SCHEDULE                        PRTSCH
  42.      I              BLINK                           BLINK
  43.      I              RSTLIBL                         RSTLBL
  44.      I              LIBL                            LIBL
  45.      I              MBRLST                          MBRLST
  46.      I              DFTYPE                          DFTYPE
  47.      I              SHARE                           SHARE
  48.      I              OPTIMIZE                        OPTMIZ
  49.       *
  50.      I           SDS
  51.      I                                     *PROGRAM PGMNAM
  52.      I                                     *STATUS  STATUS
  53.      I                                     *PARMS   PARMS
  54.      I                                       40  46 ESCID
  55.      I                                       91 170 MSGTXT
  56.      C           *ENTRY    PLIST
  57.      C                     PARM           USR
  58.      C           *IN10     PARM *IN01     CF01
  59.      C                     PARM           MSGID
  60.      C                     PARM           MSG
  61.       /SPACE
  62.      C           *LIKE     DEFN MSGTXT    MSG
  63.      C           *LIKE     DEFN ESCID     MSGID
  64.      C           *LIKE     DEFN *IN01     CF01
  65.      C           *LIKE     DEFN *IN02     IN02
  66.      C           *LIKE     DEFN *IN11     IN11
  67.       /SPACE
  68.      C           *NAMVAR   DEFN           PGMDFT
  69.      C           *LOCK     IN   PGMDFT
  70.       *   Clear/Activate subfile.
  71.      C                     WRITECRC1235C
  72.       *   Display the "Display file's" heading.
  73.      C                     WRITECRC1235T
  74.       /SPACE
  75.       *  If new user's data area, then set on "NEW USER"
  76.       *  constant indicator.
  77.      C           *IN10     CASEQ'1'       SETDFT         12
  78.      C                     END
  79.       /SPACE
  80.      C           *IN11     DOUEQ'0'                        Begin DO *IN11
  81.       *  Display screen until modify data tag is off.
  82.      C           DISP1     TAG
  83.      C                     EXFMTCRC1235A                    Display DFT's
  84.       *  If CMD 1, then exit with no update.
  85.      C           *IN01     CABEQ'1'       EXIT             CMD1 - Exit PGM
  86.       /SPACE
  87.      C           *IN03     IFEQ '1'
  88.       *  If CMD 3, then set on change-mode indicator.
  89.       *  Also set on the modify data tag indicator (11),
  90.       *  to force loop.
  91.      C                     MOVEA'11'      *IN,10
  92.      C                     END
  93.       /SPACE
  94.      C                     END                             End DO *IN11
  95.       /SPACE
  96.       *  Stay in loop if CMD 2 is used.
  97.      C           *IN02     DOUEQ'0'                        Begin DO *IN02
  98.       *
  99.      C           *IN11     DOUEQ'0'                        Begin DO *IN11
  100.       *  Display screen until modify data tag is off.
  101.      C                     EXFMTCRC1235B                    Display DFT's
  102.       *  If CMD 1, then exit with no update.
  103.      C           *IN01     CABEQ'1'       EXIT             CMD1 - Exit PGM
  104.      C           *IN02     CABEQ'1'       DISP1            CMD2 - Previous
  105.       /SPACE
  106.      C           *IN03     IFEQ '1'
  107.       *  If CMD 3, then set on change-mode indicator.
  108.       *  Also set on the modify data tag indicator (11),
  109.       *  to force loop.
  110.      C                     MOVEA'11'      *IN,10
  111.      C                     END
  112.       /SPACE
  113.      C                     END                             End DO *IN11
  114.       /SPACE
  115.       *  The field SWS is used to insure that
  116.       *  the subfile will only be built once.
  117.      C           SWS       CASNE'1'       BLDSFL           Build subfile
  118.      C                     END
  119.       /SPACE
  120.      C           *IN11     DOUEQ'0'                        Begin DO
  121.      C                     EXFMTCRC1235C                    Display LibL
  122.      C                     MOVEL*IN02     IN02             Save 02
  123.       /SPACE
  124.       *  If CMD 1, then exit with no update.
  125.      C           *IN01     CABEQ'1'       EXIT             CMD1 - Exit PGM
  126.       *  If in change mode, then sequence library list.
  127.      C           *IN10     CASEQ'1'       SRSFL
  128.      C                     END
  129.       /SPACE
  130.      C           *IN03     IFEQ '1'                        Begin IF *IN03
  131.       *  If CMD 3, then set on change-mode indicator.
  132.       *  This will allow input.
  133.      C                     MOVE '1'       *IN10
  134.      C                     DO   25        RRN              Begin DO
  135.       *  If change data key pressed, then update subfile
  136.       *  with allow input.
  137.      C           RRN       CHAINCRC1235D             25
  138.      C                     UPDATCRC1235D
  139.      C                     END                             End DO
  140.       *   Set on modify data tag indicator (11), to force loop.
  141.      C                     MOVE '1'       *IN11
  142.      C                     END                             End IF *IN03
  143.       /SPACE
  144.      C                     END                             End DO *IN11
  145.      C                     MOVELIN02      *IN02            Restore 02
  146.      C                     END                             End DO *IN02
  147.       /SPACE
  148.      C           *IN10     IFEQ '1'
  149.       *   Write out the modified data area.
  150.      C                     OUT  PGMDFT
  151.      C                     END
  152.       /SPACE
  153.      C           EXIT      TAG
  154.       *   Move message info into parameter list.
  155.      C                     MOVELMSGTXT    MSG
  156.      C                     MOVELESCID     MSGID
  157.       *   Exit program.
  158.      C                     UNLCKPGMDFT
  159.      C                     MOVEL'1'       *INLR
  160.       /SPACE
  161.      CSR         SETDFT    BEGSR
  162.       *  Set up a new user defaults data area's default values.
  163.      C                     MOVEL*BLANKS   SRCF             Source file
  164.      C                     MOVEL*BLANKS   SRCFLB           Source file lib
  165.      C                     MOVEL'QGPL'    OBJLB            Object library
  166.      C                     MOVEL'QBATCH'  JOBD             Job description
  167.      C                     MOVEL*BLANKS   JOBDLB           Job desc. lib
  168.      C                     MOVEL'*YES'    LOG              Log commands
  169.      C                     MOVEL'*NOLIST' SIGNOF           Sign off
  170.      C                     MOVEL'*JOB'    LOGCLP           Log CL pgm cmds
  171.      C                     MOVEL'*YES'    ALWRTV           Allow retreive CL
  172.      C                     MOVEL'*USER'   USRPRF           Adopt user prf.
  173.      C                     MOVEL'*NORMAL' PUBAUT           Public aut.
  174.      C                     MOVEL'*NO'     RSTDSP           Restore display
  175.      C                     MOVEL'*YES'    DFRWRT           Defer write
  176.      C                     MOVEL'10000'   SIZE1            Initial records
  177.      C                     MOVEL'1000'    SIZE2            Increment rcds.
  178.      C                     MOVEL'3'       SIZE3            Max increments
  179.      C                     MOVEL'20000'   MAXRCD           PrtF max rcds.
  180.      C                     MOVEL'*JOBEND' PRTSCH           Print schedule
  181.      C                     MOVEL'*NO'     RSTLBL           Restore libl
  182.      C                     MOVEL'*YES'    BLINK            Blink cursor
  183.      C                     MOVEL'*YES'    MBRLST           Req Char-MbrLst
  184.      C                     MOVEL'*RQD'    DFTYPE           Default TYPE
  185.      C                     MOVEL'*NO'     SHARE            Share open data path
  186.      C                     MOVEL'*YES'    OPTMIZ           Optimize RPGIII?
  187.      CSR                   ENDSR
  188.       /SPACE
  189.      CSR         BLDSFL    BEGSR
  190.       *  Build subfile containing default
  191.       *  library list.
  192.       /SPACE
  193.       *  "Switch on" the SWS field switch.
  194.       *  This prohibits this subroutine from
  195.       *  being executed more than once.
  196.      C                     MOVEL'1'       SWS     1
  197.       /SPACE
  198.      C                     DO   25        RRN              Begin DO
  199.       *  Place the RRNth library into the
  200.       *  RRNth subfile record.
  201.      C                     MOVELLIBL,RRN  LIB
  202.       *  Move the current Relative Record number
  203.       *  into the subfile display sequence number.
  204.      C                     Z-ADDRRN       SEQ
  205.      C                     WRITECRC1235D
  206.      C                     END                             END DO
  207.       *  Set on the indicator that allows the
  208.       *  subfile control record and the subfile
  209.       *  to be displayed.
  210.      C                     MOVEL'1'       *IN21
  211.      CSR                   ENDSR
  212.       /SPACE
  213.      CSR         SRSFL     BEGSR
  214.       *   Validity check library list modifications.
  215.      C                     MOVEL'0'       *IN11
  216.      C                     MOVEL'0'       IN11
  217.      C                     DO   25        RRN              Begin DO
  218.      C           RRN       CHAINCRC1235D             2525  Error
  219.      C           *IN25     IFEQ '0'
  220.      C           *IN11     IFEQ '1'
  221.      C                     MOVEL'1'       IN11             SAVE 11
  222.      C                     END
  223.       /SPACE
  224.       *  Compress out deleted or unused library elements.
  225.      C           SEQ       IFEQ 0
  226.      C                     Z-ADD999.99    SEQ
  227.      C                     MOVEL*ALL' '   LIB
  228.      C                     ELSE
  229.      C           LIB       IFEQ *ALL' '
  230.      C                     Z-ADD999.99    SEQ
  231.      C                     END
  232.      C                     END
  233.       *  Place displayed library information into
  234.       *  work array/data structure element.
  235.      C                     MOVELSEQDS     SEQA,X
  236.      C                     END
  237.      C     N25             END                             End DO
  238.      C           *IN25     IFEQ '0'
  239.      C                     SORTASEQA                       Sort Seq/LibL
  240.      C                     DO   25        X                Begin DO
  241.      C           RRN       CHAINCRC1235D             25
  242.      C           *IN25     IFEQ '0'
  243.      C                     MOVELSEQA,X    SEQDS
  244.      C                     MOVELLIB       LIBL,X
  245.       *  Move new Relative record number into
  246.       *  subfile sequence number.
  247.      C                     Z-ADDRRN       SEQ
  248.       *  Update subfile record with new library list data.
  249.      C                     UPDATCRC1235D
  250.      C                     END                             End IF
  251.      C                     END                             End DO
  252.      C                     END                             End IF
  253.      C                     MOVELIN11      *IN11
  254.      CSR                   ENDSR
  255.       /SPACE
  256.      CSR         *PSSR     BEGSR
  257.      C           *IN25     IFEQ '0'
  258.      C           STATUS    IFEQ 09999
  259.      C                     MOVELESCID     MSGID
  260.      C                     MOVELMSGTXT    MSG
  261.      C                     UNLCKPGMDFT                 25
  262.      C                     END
  263.      C                     END
  264.      CSR                   ENDSR'*CANCL'
  265.